home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 011 / autodesk.arc / 3DCIRC.LSP < prev    next >
Encoding:
Text File  |  1987-04-29  |  3.6 KB  |  138 lines
  1. ;**************************** 3DCIRC.LSP *********************************
  2.  
  3. ;     By Simon Jones    Autodesk Ltd, London     February 1987
  4.  
  5. ;    This macro will draw a "circle" in any orientation, with
  6. ;  3DLINES. The "circle" is effectively, a multi-sided polygon
  7. ;  with a minimum of three sides.
  8. ;*************************************************************************
  9.  
  10. ;----------- GLOBAL variables
  11.  
  12. ; ainc : Angle of inclination
  13. ; arot : Angle of rotation
  14. ; aseg : Angle per segment
  15. ; cen  : Centre point
  16. ; c    : Counter
  17. ; dx   : Delta X
  18. ; dy   : Delta Y
  19. ; dz   : Delta Z
  20. ; l    : List of 3D points
  21. ; n    : Number of lines
  22. ; rad  : Radius
  23. ; vb   : Blipmode variable
  24. ; vc   : Cmdecho variable
  25.  
  26. (vmon)
  27. (prompt "\nLoading. Please wait...")
  28. (terpri)
  29.  
  30. (defun MODES (a)
  31.    (setq MLST '())
  32.    (repeat (length a)
  33.       (setq MLST (append MLST (list (list (car a) (getvar (car a))))))
  34.       (setq a (cdr a)))
  35. )
  36.  
  37. (defun MODER ()
  38.    (repeat (length MLST)
  39.       (setvar (caar MLST) (cadar MLST))
  40.       (setq MLST (cdr MLST))
  41.    )
  42. )
  43.  
  44. (defun *ERROR* (st)
  45.   (moder)
  46.   (terpri)
  47.   (princ "\nError: ")
  48.   (princ st)
  49.   (princ)
  50. )
  51.  
  52. ;******************** MAIN PROGRAM ************************
  53.  
  54. (defun C:3DCIRC (/ cen rad n aseg ainc arot
  55.                    ang c l dx dy dz x y z pt)
  56.  
  57.    (modes '("cmdecho" "blipmode" "elevation"))
  58.    (setvar "CMDECHO" 0)
  59.  
  60.    ; Set centre point
  61.    (initget (+ 1 16))
  62.    (setq cen (getpoint "\nCentre point: "))
  63.    (setvar "elevation" (caddr cen))
  64.  
  65.    ; Set radius
  66.    (initget (+ 1 2 4) "Diameter")
  67.    (setq rad (getdist cen "\nDiameter/<Radius>: "))
  68.    (if (= rad "Diameter")
  69.        (progn
  70.         (initget (+ 1 2))
  71.         (setq rad (/ (getdist cen "\nDiameter: ") 2))
  72.        )
  73.    )
  74.  
  75.    ; Set angle of inclination (default is vertical)
  76.    (setq ainc (getangle cen "\nInclined angle <90>: "))
  77.    (if (null ainc) (setq ainc (/ pi 2)))
  78.  
  79.    ; Set rotational angle
  80.    (setq arot (getangle cen "\nRotational angle <0>: "))
  81.    (if (null arot) (setq arot 0))
  82.  
  83.    ; Circle resolution
  84.    (while (< n 3)
  85.           (initget (+ 2 4))
  86.           (setq n (getint "\nNumber of lines <16>: "))
  87.           (cond ((null n) (setq n 16))
  88.                 ((< n 3) (prompt "\nMust be greater than 2 lines. "))
  89.           )
  90.    )
  91.  
  92.    (setq aseg (/ (* 2 pi) n)) ;Angle per segment
  93.    (setq ang 0 c 0 l nil)
  94.  
  95.    ; Calculate points around "circle"
  96.    (while (< c (1+ n))
  97.  
  98.           ; Calculate points for vertical circle
  99.           (setq dx (* rad (cos ang)))
  100.           (setq dz (* rad (sin ang)))
  101.           (setq dy 0)
  102.  
  103.           ; Rotate points through incline angle
  104.           ;if not vertical
  105.           (if (/= (fix (abs (sin ainc))) 1)
  106.               (progn
  107.                (setq dy (* dz (cos ainc)))
  108.                (setq dz (* dz (sin ainc)))
  109.               )
  110.           )
  111.  
  112.           (setq x (+ (car cen) dx))
  113.           (setq y (+ (cadr cen) dy))
  114.           (setq z (+ (caddr cen) dz))
  115.  
  116.           ; Rotate points around vertical axis
  117.           (setq pt (polar cen
  118.                           (+ (angle cen (list x y)) arot)
  119.                           (distance cen (list x y))
  120.                    )
  121.           )
  122.           (setq pt (append pt (list z)))
  123.           (setq l (append l (list pt))) ;Add next point to list
  124.           (setq ang (+ ang aseg))
  125.           (prompt "\rGenerating lines - ") (princ c)
  126.           (setq c (1+ c))
  127.    )
  128.  
  129.    ; Draw "circle"
  130.    (setvar "BLIPMODE" 0)
  131.    (command "3DLINE")         ; Enter 3DLINE command
  132.    (foreach n l (command n))  ; Pass over each 3d point
  133.    (command "")               ; End command
  134.  
  135.    (moder)
  136.    (princ)
  137. )
  138.